(*
  Copyright (c) 2009 Barry Schwartz

  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
  files (the "Software"), to deal in the Software without
  restriction, including without limitation the rights to use,
  copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following
  conditions:

  The above copyright notice and this permission notice shall be
  included in all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  OTHER DEALINGS IN THE SOFTWARE.
*)

(* conversion functions to/from unicode *)

open Char
open Pycaml
open Python_tools
open UTypes
  
(*-----------------------------------------------------------------------*)

let read_uc = ref (fun _ -> (-1))
let write_uc = ref (fun _ _ -> ())
let to_u_conv = ref (fun s -> s)
let from_u_conv = ref (fun s -> s)
let read_uc_char cs = !read_uc (IO.coerce_i cs)
let write_uc_char cs x = !write_uc (IO.coerce_o cs) x
let to_unicode str = !to_u_conv str
let from_unicode str = !from_u_conv str
  

(* ASCII encoding *)

let read_ascii_char cs = IO.read_byte cs
let write_ascii_char cs x = if x < 128 then IO.write_byte cs x else ()
let conv_ascii_to_uc str = str
let conv_uc_to_ascii str = List.filter (fun c -> c < 128) str
  

(* latin 1 encoding *)

let read_latin1_char cs = IO.read_byte cs
let write_latin1_char cs x = if x < 256 then IO.write_byte cs x else ()
let conv_latin1_to_uc str = str
let conv_uc_to_latin1 str = List.filter (fun c -> c < 256) str

  
(* UTF-8 encoding *)

let rec conv_utf8_to_uc str =
  match str with
    | [] -> []
    | c :: cs ->
        if c < 0x80 then
          c :: (conv_utf8_to_uc cs)
        else if c < 0xc0 then           (* should never happen *)
          c :: (conv_utf8_to_uc cs)
        else if c < 0xe0 then
          begin
            match cs with
              | c2 :: cs ->
                  (((0x40 * (c - 0xc0)) + c2) - 0x80) :: (conv_utf8_to_uc cs)
              | _ -> [ 0x40 * (c - 0xc0) ]
          end
        else
          begin
            match cs with
              | c2 :: c3 :: cs ->
                  ((((0x1000 * (c - 0xe0)) + (0x40 * (c2 - 0x80))) + c3) - 0x80) ::
                    (conv_utf8_to_uc cs)
              | _ -> [ 0x1000 * (c - 0xe0) ]
          end
  
let rec conv_uc_to_utf8 str =
  match str with
    | [] -> []
    | c :: cs ->
        if c < 0x80 then
          c :: (conv_uc_to_utf8 cs)
        else if c < 0x800 then
          (0xc0 + (c lsr 6)) :: (0x80 + (c land 0x3f)) ::
            (conv_uc_to_utf8 cs)
        else
          (0xe0 + (c lsr 12)) :: (0x80 + ((c lsr 6) land 0x3f)) ::
            (0x80 + (c land 0x3f)) :: (conv_uc_to_utf8 cs)
  
let set_string_format fmt =
  match fmt with
    | `ASCII ->
        read_uc := read_ascii_char;
        write_uc := write_ascii_char;
        to_u_conv := conv_ascii_to_uc;
        from_u_conv := conv_uc_to_ascii
    | `Latin1 ->
        read_uc := read_latin1_char;
        write_uc := write_latin1_char;
        to_u_conv := conv_latin1_to_uc;
        from_u_conv := conv_uc_to_latin1
    | `UTF8 ->
        read_uc := IO.read_utf8_char;
        write_uc := IO.write_utf8_char;
        to_u_conv := conv_utf8_to_uc;
        from_u_conv := conv_uc_to_utf8
    | `Unicode ->
        read_uc := IO.read_be_u16;
        write_uc := IO.write_be_u16;
        to_u_conv := (fun s -> s);
        from_u_conv := (fun s -> s)
    | _ -> raise (Invalid_argument "unknown format")
  
let string_to_bytes str =
  let rec iter list i =
    if i < 0 then
      list
    else
      iter ((int_of_char str.[i]) :: list) (i - 1)
  in
    iter [] ((String.length str) - 1)
  
let bytes_to_string list =
  let str = String.create (List.length list) in
  let rec iter i list =
    match list with
      | [] -> str
      | c :: cs -> (str.[i] <- char_of_int c; iter (i + 1) cs)
  in
    iter 0 list
  
let of_ascii = string_to_bytes
let to_ascii = bytes_to_string
  
let uc_string_of_ascii str =
  let len = String.length str
  in Array.init len (fun i -> int_of_char str.[i])
  
let uc_string_to_ascii arr =
  let len = Array.length arr in
  let str = String.create len in
    for i = 0 to len - 1 do
      str.[i] <- char_of_int arr.(i)
    done;
    str
  
let of_string str = to_unicode (string_to_bytes str)
let to_string list = bytes_to_string (from_unicode list)
  
let append s1 s2 =
  let len1 = Array.length s1 in
  let len2 = Array.length s2 in
    Array.init (len1 + len2)
      (fun i ->
         if i < len1 then
           s1.(i)
         else
           s2.(i - len1))
  
let rec compare_uc_strings s1 s2 =
  match (s1, s2) with
    | ([], []) -> 0
    | ([], _) -> (-1)
    | (_, []) -> 1
    | (c1 :: cs1, c2 :: cs2) ->
        if c1 < c2 then
          (-1)
        else if c1 > c2 then
          1
        else
          compare_uc_strings cs1 cs2

(*-----------------------------------------------------------------------*)

let uc_char_to_utf8 c =
  let is_one_byte ch = (ch <= 0x7F) in
  let is_two_byte ch = (0x80 <= ch && ch <= 0x7FF) in
  let is_three_byte ch = (0x800 <= ch && ch <= 0xFFFF) in
  let is_four_byte ch = (0x10000 <= ch && ch <= 0x10FFFF) in
  if is_one_byte c then
    String.make 1 (Char.chr c)
  else if is_two_byte c then
    (String.make 1 (Char.chr (0b11000000 + (c lsr 6)))) ^
    (String.make 1 (Char.chr (0b10000000 + (c land 0b111111))))
  else if is_three_byte c then
    (String.make 1 (Char.chr (0b11100000 + (c lsr 12)))) ^
    (String.make 1 (Char.chr (0b10000000 + ((c lsr 6) land 0b111111)))) ^
    (String.make 1 (Char.chr (0b10000000 + (c land 0b111111))))
  else if is_four_byte c then
    (String.make 1 (Char.chr (0b11110000 + (c lsr 18)))) ^
    (String.make 1 (Char.chr (0b10000000 + ((c lsr 12) land 0b111111)))) ^
    (String.make 1 (Char.chr (0b10000000 + ((c lsr 6) land 0b111111)))) ^
    (String.make 1 (Char.chr (0b10000000 + (c land 0b111111))))
  else
    raise (Invalid_argument "UString.uc_char_to_utf8")

let uc_string_to_utf8 s =
  Array.fold_left (fun result c -> result ^ uc_char_to_utf8 c) "" s

(*-----------------------------------------------------------------------*)

let is_ascii c          = c <= '\x7F'
let is_first_of_two c   = '\xC2' <= c && c <= '\xDF'
let is_first_of_three c = '\xE0' <= c && c <= '\xEF'
let is_first_of_four c  = '\xF0' <= c && c <= '\xF4'
let is_later c          = '\x80' <= c && c <= '\xBF'

let utf8_to_uc_list s =

  let s_length = String.length s in

  let rec convert i char_codes =
    if i = s_length then
      List.rev char_codes
    else if is_ascii s.[i] then
      convert (i + 1) ((code s.[i]) :: char_codes)
    else if (is_first_of_two s.[i]) && (is_later s.[i + 1]) then
      convert (i + 2) ((((((code s.[i]) land 0b11111) lsl 6)
                         + ((code s.[i + 1]) land 0b111111))) :: char_codes)
    else if (is_first_of_three s.[i]) && (is_later s.[i + 1]) && (is_later s.[i + 2]) then
      convert (i + 3) ((((((code s.[i]) land 0b1111) lsl 12)
                         + (((code s.[i + 1]) land 0b111111) lsl 6)
                         + ((code s.[i + 2]) land 0b111111))) :: char_codes)
    else if (is_first_of_four s.[i]) && (is_later s.[i + 1]) && (is_later s.[i + 2]) && (is_later s.[i + 3]) then
      convert (i + 4) ((((((code s.[i]) land 0b111) lsl 18)
                         + (((code s.[i + 1]) land 0b111111) lsl 12)
                         + (((code s.[i + 2]) land 0b111111) lsl 6)
                         + ((code s.[i + 3]) land 0b111111))) :: char_codes)
    else
      raise (Invalid_argument "UString.utf8_to_uc_list")
  in
    try
      convert 0 []
    with
        Invalid_argument _ -> raise (Invalid_argument "UString.utf8_to_uc_list")

let utf8_to_uc_string u = Array.of_list (utf8_to_uc_list u)

(*-----------------------------------------------------------------------*)

(* FIX: make this return a Python unicode object. *)
let pythonize_uc_string u =
  pythonize_string (uc_string_to_utf8 u)

let unpythonize_uc_string py_u =
  utf8_to_uc_string (unpythonize_string py_u)

(* FIX: Write an OCaml/C version rather than call the Python/C version. *)
let glyph_name_to_uc_string name =
  let glyph_name_module = py_module "glyph_name" in
  let py_args = pytuple_fromsingle (pybytes_fromstring name) in
  let py_uni = py_module_call glyph_name_module "glyph_name_to_unicode" py_args in
    if py_uni = pynull () then
      [| |]
    else
      unpythonize_uc_string py_uni

(*-----------------------------------------------------------------------*)
